home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / turbovis / tvtoys04.zip / TVVIDEO.PAS < prev    next >
Pascal/Delphi Source File  |  1993-12-18  |  9KB  |  285 lines
  1. (***************************************************************************
  2.   TVVideo unit
  3.   Turbo Vision extended video modes support routines
  4.   PJB August 30, 1993, Internet mail to d91-pbr@nada.kth.se
  5.   Copyright PJB 1993, All Rights Reserved. Portions Copyright Borland.
  6.   Free source, use at your own risk.
  7.   If modified, please state so if you pass this around.
  8.  
  9.     ■ TVVIDEO NO LONGER SUPPORTS smFont8x8 or smSpecialFont8x8
  10.  
  11.       Use ToggleVideoLines instead, or SetInternalFont.
  12.  
  13.     ■ PLEASE remember (I didn't) to use
  14.  
  15.       SetSpecialVideoMode instead of SetVideoMode
  16.  
  17. ***************************************************************************)
  18. unit TVVideo;
  19. {$I toyCfg}
  20.  
  21. {$B-,O+,Q-,X+}
  22.  
  23. interface
  24.  
  25.   uses
  26.     App, Drivers, Objects, Memory, Views,
  27.     Dos,
  28.     Video;
  29.  
  30.   type
  31.     LastFontType = (lfInternalFont, lfDiskFont, lfResourceFont);
  32.  
  33.   const
  34.     (* TVToys doesn't support smFont8x8, this might avoid disasters *)
  35.     smFont8x8 = 0;
  36.  
  37.   var
  38.     (* INEXACT value, used for screen lines calculations *)
  39.     VideoScanLines : Integer;
  40.     (* Tpye of font last loaded *)
  41.     LastFontTypeUsed : LastFontType;
  42.  
  43.  
  44.   procedure PreventModeSwitch;
  45.   procedure CheckScanLines;
  46.   procedure SetSpecialScreenMode(Mode:Word);
  47.   procedure SetInternalFont(Font:Byte);
  48.   procedure SetUserFont(Points:Byte; Font:Pointer);
  49.   procedure ToggleVideoLines;
  50.   procedure InitTVVideo;
  51.  
  52.   procedure DoNothing;
  53.  
  54.   const
  55.     (* Called when video mode changed *)
  56.     VideoModeChanged : Procedure = DoNothing;
  57.  
  58.  
  59. (***************************************************************************
  60. ***************************************************************************)
  61. implementation
  62.  
  63.  
  64.   (*******************************************************************
  65.     This is the normal ReloadLastFont procedure
  66.   *******************************************************************)
  67.   procedure DoNothing; assembler; asm end;
  68.  
  69.  
  70.   (*******************************************************************
  71.     From Borlands DRIVERS unit
  72.   *******************************************************************)
  73.   function GetCrtMode:Word; assembler;
  74.   asm
  75.       PUSH      BP
  76.  
  77.       MOV    AH,0FH
  78.       INT       10H
  79.  
  80.       PUSH    AX
  81.       MOV    AX,1130H
  82.       MOV    BH,0
  83.       MOV    DL,0
  84.       INT       10H
  85.       POP    AX
  86.  
  87.       MOV    DH,AH
  88.       CMP    DL,25
  89.       SBB    AH,AH
  90.       INC    AH
  91.  
  92.       POP       BP
  93.   end;
  94.  
  95.   (*******************************************************************
  96.     Call this before InitVideo or DoneVideo to stop them from
  97.     changing the video mode. This procedure *destroys* StartUpMode.
  98.     Save StartUpMode (MyApp.Init; Save:=StartUpMode;) if you want to
  99.     restore the video mode (StartUpMode:=Save; MyApp.Done;) on exit.
  100.  
  101.     Try this to keep the startup video mode (132-cols etc) active:
  102.       begin
  103.         if IsProbablyTextMode then PreventModeSwitch;
  104.         MyApp.Init; MyApp.Run; MyApp.Done;
  105.       end.
  106.   *******************************************************************)
  107.   procedure PreventModeSwitch;
  108.   begin
  109.     StartUpMode:=GetCrtMode;
  110.     ScreenMode:=StartUpMode;
  111.   end;
  112.  
  113.  
  114.   (*******************************************************************
  115.     Try to make VideoScanLines reflect maximum number of scan lines
  116.     in this video mode
  117.   *******************************************************************)
  118.   procedure CheckScanLines;
  119.     var
  120.       ScanLines : Integer;
  121.   begin
  122.     ScanLines:=GetCurrentScanLines;
  123.     if (Abs(ScanLines-VideoScanLines)>16) or (ScanLines>VideoScanLines) then
  124.       VideoScanLines:=ScanLines;       (* Screen size has changed! *)
  125.  
  126.     case VideoScanLines of             (* Screen could probably be higher *)
  127.       340..349:  VideoScanLines:=350;
  128.       390..399:  VideoScanLines:=400;
  129.       470..479:  VideoScanLines:=480;
  130.       590..599:  VideoScanLines:=600;
  131.     end;
  132.   end;
  133.  
  134.  
  135.   (*******************************************************************
  136.     Center all views on the desktop
  137.   *******************************************************************)
  138.   procedure ReCenterDesktop;
  139.     procedure ReCenter(P:PView); far;
  140.       var
  141.         X,Y : integer;
  142.     begin
  143.       X:=P^.Origin.X;
  144.       Y:=P^.Origin.Y;
  145.  
  146.       if P^.Options and ofCenterX <> 0 then
  147.         X:=(Desktop^.Size.X - P^.Size.X) div 2;
  148.       if P^.Options and ofCenterY <> 0 then
  149.         Y:=(Desktop^.Size.Y - P^.Size.Y) div 2;
  150.  
  151.       P^.MoveTo(X, Y);
  152.     end;
  153.   begin
  154.     Desktop^.ForEach(@ReCenter);
  155.     Application^.ForEach(@ReCenter);
  156.   end;
  157.  
  158.  
  159.   (*******************************************************************
  160.     Initialize TV video stuff
  161.     This is separate procedure so we can use it for font changes etc
  162.   *******************************************************************)
  163.   procedure InitTVVideo;
  164.     var
  165.       R    : TRect;
  166.   begin
  167.     PreventModeSwitch;         (* Disable InitVideo mode switch *)
  168.     InitVideo;                 (* Recalc CRT data *)
  169.  
  170.     if VideoType=EGA then      (* This is Borland's idea *)
  171.     asm
  172.       push bp
  173.       mov  es,Seg0040
  174.       or   es:[CrtInfo].Byte,1 (* Disable CGA cursor emulation *)
  175.  
  176.       mov  ah,1
  177.       mov  cx,0600h            (* Set cursor size: Start 6, End 0 *)
  178.       int  10h
  179.       pop  bp
  180.     end;
  181.  
  182.     DoneMemory;                (* Dispose of cache buffers *)
  183.     InitMemory;
  184.     Application^.InitScreen;   (* Calculate shadow sizes (debatable) *)
  185.  
  186.     Application^.Buffer:=Nil;  (* Disable all screen writing *)
  187.  
  188.     R.Assign(0, 0, ScreenWidth, ScreenHeight);
  189.     Application^.ChangeBounds(R);    (* Resize application *)
  190.     ReCenterDesktop;                 (* Center desktop items *)
  191.  
  192.     if IsColorMode then         (* Let's hope this works *)
  193.       PtrRec(ScreenBuffer).Seg:=SegB800
  194.     else
  195.     begin
  196.       ShadowSize.X := 0;
  197.       ShadowSize.Y := 0;
  198.       ShowMarkers := True;
  199.       AppPalette := apMonochrome;
  200.       PtrRec(ScreenBuffer).Seg:=SegB000;
  201.     end;
  202.     Application^.Buffer:=ScreenBuffer;
  203.  
  204.     Application^.Redraw;        (* Draw menubar, desktop and statusline *)
  205.     ShowMouse;
  206.  
  207.     CheckScanLines;
  208.     ScreenMode:=GetSpecialVideoMode;
  209.  
  210.     if Mem[Seg0040:CrtRows]<>24 then
  211.     asm                         (* This is Borland's idea *)
  212.       mov  ah,12h               (* Use alternate PrtScr handler *)
  213.       mov  bl,20h
  214.       push bp
  215.       int  10h
  216.       pop  bp
  217.     end;
  218.   end;
  219.  
  220.  
  221.   (*******************************************************************
  222.     Use this procedure to change video mode instead of SetScreenMode
  223.     which will not set modes other than 2,3 and 7.
  224.  
  225.     DON'T use SetScreenMode if you use SetSpecialVideoMode.
  226.     The display wont be redrawn if the screen size doesn't change.
  227.     This is a design flaw at the heart of Turbo Vision
  228.   *******************************************************************)
  229.   procedure SetSpecialScreenMode(Mode:Word);
  230.   begin
  231.     HideMouse;
  232.  
  233.     SetSpecialVideoMode(Mode);
  234.     VideoScanLines:=GetCurrentScanLines;
  235.     VideoModeChanged;
  236.  
  237.     InitTVVideo;
  238.   end;
  239.  
  240.  
  241.   (*******************************************************************
  242.     TV wrapper for Video.UseInternalFont
  243.   *******************************************************************)
  244.   procedure SetInternalFont(Font:Byte);
  245.   begin
  246.     HideMouse;
  247.     UseInternalFont(Font);
  248.     InitTVVideo;
  249.   end;
  250.  
  251.  
  252.   (*******************************************************************
  253.     Load a character definition table
  254.     Points is the character height
  255.     Font points to an array of character bitmaps for all 256 chars,
  256.     ASCII 0 first, occupying Points bytes per char, top to bottom.
  257.     Character array must contain at least 256*Points bytes.
  258.   *******************************************************************)
  259.   procedure SetUserFont(Points:Byte; Font:Pointer);
  260.   begin
  261.     HideMouse;
  262.     LoadUserFont(Points, 0, 256, Font);
  263.     InitTVVideo;
  264.   end;
  265.  
  266.  
  267.   (*******************************************************************
  268.     Replacement code to toggle the number of video lines
  269.   *********************************************